home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Oberon⁄F™ 1.2 / Preinstalled version / Obx / Mod / Twins / Twins (.txt)
Encoding:
Oberon Document  |  1996-07-08  |  9.3 KB  |  257 lines  |  [oODC/obnF]
  1. Documents.StdDocumentDesc
  2. Documents.DocumentDesc
  3. Containers.ViewDesc
  4. Views.ViewDesc
  5. Stores.StoreDesc
  6. Documents.ModelDesc
  7. Containers.ModelDesc
  8. Models.ModelDesc
  9. Stores.ElemDesc
  10. TextViews.StdViewDesc
  11. TextViews.ViewDesc
  12. TextModels.StdModelDesc
  13. TextModels.ModelDesc
  14. TextModels.AttributesDesc
  15. Helvetica
  16. Helvetica
  17. Helvetica
  18. MODULE ObxTwins;
  19.     IMPORT Domains, Ports, Stores, Models, Views, Controllers, Properties, TextViews;
  20.     CONST
  21.         minVersion = 1; maxVersion = 1;    (* old version 0 ObxTwin views cannot be read anymore *)
  22.         border = 2 * Ports.mm;
  23.         initContents = FALSE; copyContents = TRUE;
  24.     TYPE
  25.         Context = POINTER TO ContextDesc;
  26.         ContextDesc = RECORD (Models.ContextDesc)
  27.             view: Views.View;    (* contained view *)
  28.             w, h: LONGINT;    (* size of contained view *)
  29.             domain: Domains.Domain    (* domain of container model *)
  30.         END;
  31.         Model = POINTER TO ModelDesc;
  32.         ModelDesc = RECORD (Models.ModelDesc)
  33.             width, topHeight, botHeight: LONGINT;
  34.             top, bottom: Context
  35.         END;
  36.         View = POINTER TO ViewDesc;
  37.         ViewDesc = RECORD (Views.ViewDesc)
  38.             model: Model;
  39.             focus: Context    (* current focus; either model.top or model.bottom *)
  40.         END;
  41.     (* Context *)
  42.     PROCEDURE (c: Context) ThisDomain (): Domains.Domain;
  43.     BEGIN
  44.         RETURN c.domain
  45.     END ThisDomain;
  46.     PROCEDURE (c: Context) GetSize (VAR w, h: LONGINT);
  47.     BEGIN
  48.         w := c.w - border;
  49.         h := c.h - border
  50.     END GetSize;
  51.     PROCEDURE (c: Context) Normalize (): BOOLEAN;
  52.     BEGIN
  53.         RETURN TRUE    (* current scroll positions won't be stored, and scrolling isn't undoable *)
  54.     END Normalize;
  55.     PROCEDURE CopyOf (source: Context; copyContents: BOOLEAN): Context;    (* make a deep copy of a context *)
  56.         VAR c: Context; st: Stores.Store; v: Views.View; m, n: Models.Model;
  57.     BEGIN
  58.         NEW(c);
  59.         st := Stores.Clone(source.view); v := st(Views.View);
  60.         m := source.view.ThisModel();
  61.         IF m # NIL THEN
  62.             st := Stores.Clone(m); n := st(Models.Model);
  63.             IF copyContents THEN n.CopyAllFrom(m) ELSE n.InitFrom(m) END;
  64.             v.InitModel(n)
  65.         END;
  66.         v.CopyFrom(source.view);
  67.         c.view := v; c.w := source.w; c.h := source.h; v.InitContext(c);
  68.         RETURN c
  69.     END CopyOf;
  70.     PROCEDURE InitDomain (c: Context; d: Domains.Domain);
  71.     BEGIN
  72.         c.domain := d; c.view.InitDomain(d)
  73.     END InitDomain;
  74.     PROCEDURE NewContext (v: Views.View; w, h: LONGINT): Context;
  75.         VAR c: Context;
  76.     BEGIN
  77.         NEW(c);
  78.         c.view := v; c.w := w; c.h := h; v.InitContext(c);
  79.         RETURN c
  80.     END NewContext;
  81.     (* Model *)
  82.     PROCEDURE (m: Model) Internalize (VAR rd: Stores.Reader);
  83.         VAR thisVersion: SHORTINT; v: Views.View;
  84.     BEGIN
  85.         m.Internalize^(rd);
  86.         IF ~rd.cancelled THEN
  87.             rd.ReadVersion(minVersion, maxVersion, thisVersion);
  88.             IF~ rd.cancelled THEN
  89.                 rd.ReadLInt(m.width);
  90.                 rd.ReadLInt(m.topHeight);
  91.                 rd.ReadLInt(m.botHeight);
  92.                 Views.ReadView(rd, v); m.top := NewContext(v, m.width, m.topHeight);
  93.                 Views.ReadView(rd, v); m.bottom := NewContext(v, m.width, m.botHeight)
  94.             END
  95.         END
  96.     END Internalize;
  97.     PROCEDURE (m: Model) Externalize (VAR wr: Stores.Writer);
  98.     BEGIN
  99.         m.Externalize^(wr);
  100.         wr.WriteVersion(maxVersion);
  101.         wr.WriteLInt(m.width);
  102.         wr.WriteLInt(m.topHeight);
  103.         wr.WriteLInt(m.botHeight);
  104.         Views.WriteView(wr, m.top.view);
  105.         Views.WriteView(wr, m.bottom.view)
  106.     END Externalize;
  107.     PROCEDURE (m: Model) CopyAllFrom (source: Models.Model);
  108.     BEGIN
  109.         WITH source: Model DO
  110.             m.width := source.width;
  111.             m.topHeight := source.topHeight;
  112.             m.botHeight := source.botHeight;
  113.             m.top := CopyOf(source.top, copyContents);
  114.             m.bottom := CopyOf(source.bottom, copyContents)
  115.         END
  116.     END CopyAllFrom;
  117.     PROCEDURE (m: Model) InitFrom (source: Models.Model);
  118.     BEGIN
  119.         WITH source: Model DO
  120.             m.width := source.width;
  121.             m.topHeight := source.topHeight;
  122.             m.botHeight := source.botHeight;
  123.             m.top := CopyOf(source.top, initContents);
  124.             m.bottom := CopyOf(source.bottom, initContents)
  125.         END
  126.     END InitFrom;
  127.     PROCEDURE (m: Model) InitDomain (d: Domains.Domain);
  128.     BEGIN
  129.         m.InitDomain^(d);
  130.         InitDomain(m.top, d);
  131.         InitDomain(m.bottom, d)
  132.     END InitDomain;
  133.     (* View *)
  134.     PROCEDURE (v: View) InitModel (m: Models.Model);
  135.     BEGIN
  136.         ASSERT((v.model = NIL) OR (m = v.model), 20);
  137.         ASSERT(m # NIL, 21); ASSERT(m IS Model, 23);
  138.         v.model := m(Model);
  139.         v.focus := v.model.bottom
  140.     END InitModel;
  141.     PROCEDURE (v: View) ThisModel (): Model;
  142.     BEGIN
  143.         RETURN v.model
  144.     END ThisModel;
  145.     PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
  146.         VAR thisVersion: SHORTINT; s: Stores.Store;
  147.     BEGIN
  148.         v.Internalize^(rd);
  149.         IF ~rd.cancelled THEN
  150.             rd.ReadVersion(minVersion, maxVersion, thisVersion);
  151.             IF ~rd.cancelled THEN
  152.                 rd.ReadStore(s); ASSERT(s # NIL, 100);
  153.                 v.InitModel(s(Model))
  154.             END
  155.         END
  156.     END Internalize;
  157.     PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
  158.     BEGIN
  159.         v.Externalize^(wr);
  160.         wr.WriteVersion(maxVersion);
  161.         wr.WriteStore(v.model)
  162.     END Externalize;
  163.     PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: LONGINT);
  164.         VAR m: Model; w: Views.View;
  165.     BEGIN
  166.         m := v.model;
  167.         f.DrawLine(0, m.topHeight, m.width, m.topHeight, f.dot, Ports.black);
  168.         (* install the subframes for the subviews *)
  169.         w := m.top.view; Views.InstallFrame(f, w, Ports.mm, Ports.mm, 0, v.focus.view = w);
  170.         w := m.bottom.view; Views.InstallFrame(f, w, Ports.mm, Ports.mm + m.topHeight, 1, v.focus.view = w)
  171.     END Restore;
  172.     PROCEDURE SetFocus (v: Views.View; x, y: LONGINT): BOOLEAN;
  173.         VAR p: Properties.FocusPref;
  174.     BEGIN    (* determine whether v should be focused when the mouse is clicked at (x, y) in v *)
  175.         p.hotFocus := FALSE;
  176.         p.atLocation := TRUE; p.x := x; p.y := y;
  177.         p.setFocus := FALSE; p.selectOnFocus := FALSE;
  178.         v.HandlePropMsg(p);
  179.         RETURN p.setFocus
  180.     END SetFocus;
  181.     PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Views.CtrlMessage;
  182.                                                             VAR focus: Views.View);
  183.         VAR g: Views.Frame; m: Model; newFocus: Context; mMsg: Controllers.MarkMsg; prop: Properties.Property;
  184.     BEGIN
  185.         m := v.model;
  186.         WITH msg: Controllers.CursorMessage DO
  187.             IF msg.y >= m.topHeight THEN newFocus := m.bottom ELSE newFocus := m.top END;
  188.             focus := newFocus.view;
  189.             IF (newFocus # v.focus) & ((msg IS Controllers.TrackMsg) OR (msg IS Controllers.DropMsg)) &
  190.                 SetFocus(focus, msg.x, msg.y) THEN
  191.                 (* remove marks in old focus *)
  192.                 mMsg.show := FALSE;
  193.                 g := Views.ThisFrame(f, v.focus.view); IF g # NIL THEN Views.ForwardCtrlMsg(g, mMsg) END;
  194.                 v.focus := newFocus;    (* set new focus *)
  195.                 (* set marks in new focus *)
  196.                 mMsg.show := TRUE;
  197.                 g := Views.ThisFrame(f, v.focus.view); IF g # NIL THEN Views.ForwardCtrlMsg(g, mMsg) END
  198.             END
  199.         (* the following scrolling-oriented messages are always sent to bottom view, independent of focus *)
  200.         | msg: Controllers.PollSectionMsg DO
  201.             g := Views.ThisFrame(f, m.bottom.view); IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END;
  202.             IF ~msg.done THEN msg.valid := FALSE; msg.done := TRUE END; (* disable default-scrolling *)
  203.         | msg: Controllers.ScrollMsg DO
  204.             g := Views.ThisFrame(f, m.bottom.view); IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END;
  205.             msg.done := TRUE;
  206.         | msg: Controllers.PageMsg DO
  207.             focus := m.bottom.view
  208.         ELSE    (* all other messages are sent to the focus, however *)
  209.             focus := v.focus.view
  210.         END
  211.         (* the assignment to focus signals that the view v wants to forward the message to the
  212.         corresponding embedded view *)
  213.     END HandleCtrlMsg;
  214.     PROCEDURE (v: View) HandlePropMsg (VAR msg: Views.PropMessage);
  215.     VAR prop: Properties.Property;
  216.     BEGIN
  217.         WITH msg: Properties.SizePref DO
  218.             msg.w := v.model.width; msg.h := v.model.topHeight + v.model.botHeight
  219.         | msg: Properties.ResizePref DO
  220.             msg.fixed := TRUE
  221.         ELSE
  222.             Views.HandlePropMsg(v.model.bottom.view, msg);
  223.         END
  224.     END HandlePropMsg;
  225.     PROCEDURE NewTwin* (width, topHeight, botHeight: LONGINT; top, bottom: Views.View): Views.View;
  226.         VAR m: Model; v: View;
  227.     BEGIN
  228.         NEW(m);
  229.         m.width := width; m.topHeight := topHeight; m.botHeight := botHeight;
  230.         m.top := NewContext(top, width, topHeight);
  231.         m.bottom := NewContext(bottom, width, botHeight);
  232.         NEW(v); v.InitModel(m);
  233.         RETURN v
  234.     END NewTwin;
  235.     (* example twin view with two embedded text views *)
  236.     PROCEDURE New* (): Views.View;
  237.         CONST width =  160 * Ports.mm; topHeight = 30 * Ports.mm; botHeight = 500 * Ports.mm;
  238.     BEGIN
  239.         RETURN NewTwin(width, topHeight, botHeight,TextViews.dir.StdNew(), TextViews.dir.StdNew())
  240.     END New;
  241.     PROCEDURE Deposit*;
  242.     BEGIN
  243.         Views.Deposit(New())
  244.     END Deposit;
  245. END ObxTwins.
  246. TextControllers.StdCtrlDesc
  247. TextControllers.ControllerDesc
  248. Containers.ControllerDesc
  249. Controllers.ControllerDesc
  250. TextRulers.StdRulerDesc
  251. TextRulers.RulerDesc
  252. TextRulers.StdStyleDesc
  253. TextRulers.StyleDesc
  254. TextRulers.AttributesDesc
  255. Arial
  256. Documents.ControllerDesc
  257.